home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 3 / Cream of the Crop 3.iso / comm / prtcs155.zip / NOTE.WPL < prev    next >
Text File  |  1994-01-14  |  7KB  |  255 lines
  1. /**/
  2. v="$VER: NOTE Wplrx  Roof Remote Feedback to Sysop Utility   Williamson 54.09"
  3. /* Non-Secure Inbound directory for users */
  4. indir=addslash(dequote(getclip('INDIR')))||'USERS/'
  5. /* TAGNAME of your SYSOP Feedback message base */
  6. sysopbase=GetClip('SYSOPBASE')
  7. /* Your name */
  8. sysop=GetClip('SYSOP')
  9. /* path to rexx scripts */
  10. rpath=addslash(dequote(GetClip('REXXDIR')))
  11.  
  12. options RESULTS
  13. options failat 99
  14. signal on syntax
  15. signal on halt
  16. signal on ioerr
  17. signal on break_c
  18. signal on break_d
  19.  
  20. if ~show('L', "rexxsupport.library") then
  21.     if ~addlib("rexxsupport.library", 0, -30, 0) then do
  22.          say "Couldn't access support.library !"
  23.         exit 20
  24.     end
  25.  
  26. pragma("W","NULL")
  27. log=show('P','ROOFLOG')
  28. mailer=GetCLip('SHELTER')
  29. l_mailer=lower(mailer)
  30. sv      = 'v'||right(v,5)
  31. script  = "NOTE"
  32.  
  33. cr    = '\r\n'  /* WPL  */
  34. nl    = '0a'X   /* REXX */
  35. bs    = '08'x
  36. quote = '"'
  37. msgbuf=" NOTE Feedback Posted:"date()" at "time()||nl
  38. tmsg="T:NOTE-"pragma('ID')
  39.  
  40. parse arg baud port username
  41. call send(cr||cr||'     NOTE FeedBack to Sysop 'sv' on $(host.sitename) Line 'port||cr||cr)
  42. if username="" then fname=strip(wpl_prompt(240,cr||' Please enter your name: '))
  43.     else fname=strip(username)
  44.  
  45. if fname="" then do
  46.     call send(cr||'Sorry, your name is required for Feedback to system operator'||cr)
  47.     call cleanup()
  48.     exit 0
  49. end
  50. call logusername(fname)
  51. call PutLog('Feedback from 'fname,10,10)
  52.  
  53. 'CheckCarrier'
  54. if RC~=0 then do
  55.     call PutLog('User' fname 'dropped carrier',10,10)
  56.     call cleanup
  57.     exit
  58. end
  59.  
  60. resp=wpl_prompt(240,'Subject? (RETURN aborts): ')
  61. if resp="" then do
  62.     call send(cr||' Message aborted'||cr)
  63.     call cleanup()
  64.     exit
  65. end
  66. else subject=strip(resp)
  67.  
  68. resp=upper(wpl_prompt(120,'  [Z]modem upload or [T]ext entry? '))
  69. if resp="Z" then do
  70.     ul=1
  71.     call send(cr||'  Upload your message with a filename formed as follows:'||cr)
  72.     call send('  Your_Name.NOTE, with underlines replacing any spaces in YourName.'||cr)
  73.     tmsg=indir||translate(fname,"_"," ")||".NOTE"
  74.     'Set protocol ZMODEM session "UPLOAD" inbound $(userdir) remote.sysop $(username) remote.sitename UNKNOWN'
  75.     'BeginSession $(remote.address)'
  76.     'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) $(session) from $(username) at $(remote.address)"'
  77.     'RexxMsg NY "LOGPROC" "PutLine 'l_mailer'wplstat$(line) $(p.session) $(session) $(p.protocol) $(protocol) $(p.inbound) USER $(p.rsysop) $(remote.sysop)"'
  78.     'SetMailerFlags "DN,PN"'
  79.  
  80.     'XprSetup xprzedzap.library TN,OR,B8,F0,E30,AN,DN,KN,SN,RN,NY,M8192,C$(baud)'
  81.     'SetUpDate "RAW:0/$($(line).w_offset)/640/130/Line $(line) $(protocol) $(session) $(remote.domain) $(remote.zone) $(remote.net) $(remote.node) $(remote.point) $(remote.sysop) $(remote.sitename)/AUTO/INACTIVE/NOCLOSE/NOSIZE/SCREEN$(pscreen)"'
  82.     'XprReceive ""'
  83.     'XprClose'
  84.     'SetUpdate NULL'
  85.     'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) $(remote.address) $(protocol) RC:$(RC)"'
  86.     'ReplyCall 0'
  87.     'EndSession all'
  88.     'SetStatus "$(openstatus)"'
  89. end
  90. else do
  91.     ul=0
  92.     call send(cr||' Enter your message one line (of no more than 256 characters) at a time')
  93.     call send(cr||' Hit RETURN on a blank line to select Save or continue.'||cr)
  94.     call get_sysopmsg()
  95.     editing=1;line=1;c=0
  96.     do while editing
  97.         do while resp ~= ""
  98.             'CheckCarrier'
  99.             if RC~=0 then leave
  100.             resp=wpl_prompt(300,"->"line": ")
  101.             if resp ~= "" then do
  102.                 msgbuf=msgbuf||resp||nl
  103.                 line=line+1
  104.             end
  105.         end /* hit a blank line */
  106.         'CheckCarrier'
  107.         if RC~=0 then do
  108.             msgbuf=msgbuf||'User' fname 'dropped carrier during feedback'||nl
  109.             call save_msg
  110.             call cleanup
  111.             exit
  112.         end
  113.         resp=wpl_prompt(120,cr||' You entered 'line-1' lines, [S]ave/[c]ontinue?'||cr)
  114.         if upper(resp)="S" then editing=0
  115.     end  /* finished editing */
  116.     msgbuf=msgbuf||nl
  117. end
  118.  
  119. if save_msg() then do
  120.     if ul then subject="NOTE "||subject
  121.     call send(cr||' Saving......')
  122.     if exists("RPDIR:Smsg") then do
  123.         cmd=sysopbase tmsg '"'fname'"' '"'sysop'"' subject
  124.         address COMMAND "Smsg" cmd
  125.     end;else do
  126.         cmd=rpath'Smsg.rexx' sysopbase tmsg '"'fname'"' '"'sysop'"' subject
  127.         Address "AREXX" cmd
  128.     end
  129.     call send(cr||' Message saved, thanks' fname||cr)
  130. end
  131. call send(cr||cr||' Returning to command prompt'||cr||cr)
  132. call PutLog('Posted NOTE feedback from 'fname,10,10)
  133. call cleanup()
  134. exit 0
  135.  
  136. logusername:
  137.     'String $(p.login)'
  138.     namepos=RESULT
  139.     'String $(p.session)'
  140.     sesspos=RESULT
  141.     Address "LOGPROC" "PutLine 'l_mailer'wplstat"||port sesspos script namepos arg(1) time()
  142. return
  143.  
  144. get_sysopmsg:
  145.     sysopmsg="LOG:RFSacct/h/"||translate(fname,"_"," ")||".0.0.0.0.m"
  146.     PutLog('Searching for' sysopmsg,60,10)
  147.     if ~exists(sysopmsg) then return
  148.     else do
  149.         resp=wpl_prompt(240,cr||" Reply to sysop's last message? (y/N): ")
  150.         if upper(resp) ~= "Y" then do
  151.             call send(cr||" If you do not reply, message will be displayed every time you call."||cr)
  152.             return
  153.         end
  154.     end
  155.     if ~open('sysop',sysopmsg,'r') then do
  156.         call send(cr||"Error:unable to find sysop message"||cr)
  157.         return
  158.     end
  159.     msgbuf=' Dear Sysop, In your previous message to me, you said:'||nl
  160.     call send(cr||msgbuf||cr)
  161.     do while ~eof('sysop')
  162.         tmp=" Sysop> "||readln('sysop')
  163.         call send(tmp||cr)
  164.         msgbuf=msgbuf||tmp||nl
  165.         drop tmp
  166.     end
  167.     msgbuf=msgbuf||nl
  168.     call close('sysop')
  169.     call delete(sysopmsg)
  170. return
  171.  
  172. save_msg:
  173.     if ul then do
  174.         putlog('msgul: 'tmsg,10,10)
  175.         return exists(tmsg)
  176.     end
  177.     if ~open('note',tmsg,"W") then do
  178.         call send(cr||'Unable to save message'||cr)
  179.         return 0
  180.     end
  181.     call writech('note',msgbuf)
  182.     call close('note')
  183. return 1
  184.  
  185. send:
  186.     'Print' quote||arg(1)||quote
  187.     'Send' quote||arg(1)||quote
  188. return
  189.  
  190. wpl_prompt:
  191.     'Print' quote||arg(2)||quote
  192. nprompt:
  193.     'Send' quote||arg(2)||quote
  194. getstring:
  195.     'GetInbound E0 'arg(1)
  196.     'String $(event)'
  197.     if upper(RESULT) = 'CARRIER' then do
  198.         ADdress "LOGPROC" 'PutLog 'l_mailer'wpl' time() line fname 'Dropped Carrier'
  199.         call cleanup
  200.         exit
  201.     end;else if upper(RESULT) = 'LOGIN' then do
  202.         'String $(namebuf)'
  203.         x=(RESULT) 
  204.     end;else x=""
  205. return x
  206.  
  207. lower:
  208. return(bitor(arg(1),'20'x))
  209.  
  210. PutLog:  procedure expose log script
  211. if arg(2) > GetClip('LOGLEVEL') & ~log then return 0
  212. address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
  213. address
  214. return 0
  215.  
  216. addslash:
  217. curr = arg(1)
  218. select
  219.     when right(curr, 1) = ":" then nop
  220.     when right(curr, 1) = "/" then nop
  221.         otherwise curr = curr"/"
  222. end
  223. return curr
  224.  
  225. /* a useful procedure by Walt Sullivan    */
  226. dequote:
  227.     parse arg thing
  228.     parse var thing '"' unq_thing '"'
  229.     if unq_thing ~= "" then return unq_thing
  230. return thing
  231. cleanup:
  232. return 0
  233. break_c:
  234. break_d:
  235.     PutLog('User abort',10,10)
  236.     call cleanup
  237.     exit 10
  238. novalue:
  239.         call template_oops "Novalue" sigl
  240. syntax:
  241.         call template_oops "Syntax(RC=" || RC || ")" sigl
  242. failure:
  243.         call template_oops "Failure(RC=" || RC || ")" sigl
  244. ioerr:
  245.         call template_oops "IOErr" sigl 
  246. halt:
  247.         call template_oops "Halt" sigl 
  248.  
  249. template_oops:
  250.         parse arg what badline
  251.         PutLog('Error Line:'badline what,10,10)
  252.         call cleanup
  253.         exit(40)
  254. /**/
  255.